home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src / ndebug.c next >
Encoding:
C/C++ Source or Header  |  1993-11-05  |  8.3 KB  |  315 lines  |  [TEXT/MPS ]
  1.  
  2. #ifdef MPW
  3. #    pragma segment TCLExtend
  4. #endif
  5.  
  6. /*
  7.  
  8. New Tcl debugger
  9.  
  10.     tcl proc gets executed by trace routine.
  11.  
  12.     trace is turned off while tcl proc is being executed.
  13.  
  14.     result of tcl proc, or via some control mechanism,
  15.     options will include "step in" (set trace depth higher),
  16.     "step", "stop" and "continue".  also it would be nice
  17.     to be able to change an arg, print vars, stuff like that.
  18.  
  19. can add global to disable tracing so prompt won't be traced.
  20.  
  21. see if there's a proc line number in the interpreter structure
  22.  
  23.  
  24. add a maxlevel where trace returns quickly if a maxlevel is exceeded.
  25. This allows single stepping without step-in, step-in, etc, by playing
  26. with the value.
  27.  
  28. look at return from the eval in the trace procedure as a means of
  29. determining whether to step or whatever, or maybe control it through
  30. a command or variable.
  31.  
  32. */
  33.  
  34.  
  35. /*
  36.  * ndebug.c --
  37.  *
  38.  * Tcl debugger.
  39.  *---------------------------------------------------------------------------
  40.  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  41.  *
  42.  * Permission to use, copy, modify, and distribute this software and its
  43.  * documentation for any purpose and without fee is hereby granted, provided
  44.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  45.  * Mark Diekhans make no representations about the suitability of this
  46.  * software for any purpose.  It is provided "as is" without express or
  47.  * implied warranty.
  48.  */
  49.  
  50. #include "tclExtdInt.h"
  51.  
  52. /*
  53.  * Clientdata structure for trace commands.
  54.  */
  55. #define ARG_TRUNCATE_SIZE 40
  56. #define CMD_TRUNCATE_SIZE 60
  57.  
  58. struct traceInfo_t {
  59.     Tcl_Interp *interp;
  60.     Tcl_Trace   traceHolder;
  61.     int         depth;
  62.     int         depthFloor;
  63.     };
  64. typedef struct traceInfo_t *traceInfo_pt;
  65.  
  66. static void
  67. TraceRoutine _ANSI_ARGS_((ClientData    clientData,
  68.                           Tcl_Interp   *interp,
  69.                           int           level,
  70.                           char         *command,
  71.                           int           (*cmdProc)(),
  72.                           ClientData    cmdClientData,
  73.                           int           argc,
  74.                           char         *argv[]));
  75.  
  76. static void
  77. CleanUpDebug _ANSI_ARGS_((ClientData clientData));
  78.  
  79. /*
  80.  *----------------------------------------------------------------------
  81.  *
  82.  * TraceRoutine --
  83.  *  Routine called by Tcl_Eval to trace a command.
  84.  *
  85.  *----------------------------------------------------------------------
  86.  */
  87. /* static void */
  88. void
  89. TraceRoutine (clientData, interp, level, command, cmdProc, cmdClientData, 
  90.               argc, argv)
  91.     ClientData    clientData;
  92.     Tcl_Interp   *interp;
  93.     int           level;
  94.     char         *command;
  95.     int           (*cmdProc)();
  96.     ClientData    cmdClientData;
  97.     int           argc;
  98.     char         *argv[];
  99.     {
  100.     traceInfo_pt traceInfoPtr = (traceInfo_pt) clientData;
  101.     int          idx, cmdLen, printLen;
  102.     int          result;
  103.     char         depthText[12];
  104.     char        *stepCommand;
  105.     char        *stepArgs[4];
  106.  
  107.     static int   inTraceRoutine = 0;
  108.  
  109.     /* Don't try to trace the trace routine.  (We can't delete and recreate
  110.      * the trace, because we're being called from a for-loop that won't
  111.      * see such changes, i.e. trace routines cannot safely delete traces.
  112.      *
  113.      * Also we do our own should-we-trace-at-this-depth processing rather
  114.      * than letting regular tcl handle it, so that we can change the depth
  115.      * we want without having to delete and recreate the trace.
  116.      */
  117.     if (inTraceRoutine || (level > traceInfoPtr->depth))
  118.     return;
  119.     inTraceRoutine = 1;
  120.  
  121.     if (traceInfoPtr->depthFloor == -1) {
  122.         traceInfoPtr->depthFloor = level;
  123.         traceInfoPtr->depth = level + 1;
  124.         }
  125.  
  126.     /* build up arguments to the trace routine */
  127.     sprintf (depthText, "%d", level);
  128.  
  129.     stepArgs[0] = "trace_step";
  130.     stepArgs[1] = depthText;
  131.     stepArgs[2] = command;
  132.     stepArgs[3] = Tcl_Merge (argc, argv);
  133.  
  134.     stepCommand = Tcl_Merge (4, stepArgs);
  135.  
  136.     ckfree (stepArgs[3]);
  137.  
  138.     result = Tcl_Eval (interp, stepCommand, 0, NULL);
  139.     if ((result != TCL_OK) && (result != TCL_RETURN))
  140.         {
  141. #ifdef macintosh
  142.         mac_printf("error in trace_step: %s\n", interp->result);
  143. #else
  144.         printf("error in trace_step: %s\n", interp->result);
  145. #endif
  146.         }
  147.  
  148.     ckfree (stepCommand);
  149.  
  150.     inTraceRoutine = 0;
  151.     return;
  152.     }
  153.  
  154. /*
  155.  *----------------------------------------------------------------------
  156.  *
  157.  * Tcl_TraceConCmd --
  158.  *     Implements the TCL trace control command:
  159.  *     tracecon depth [level]
  160.  *     tracecon depthfloor [level]
  161.  *
  162.  * Results:
  163.  *  Standard TCL results.
  164.  *
  165.  *----------------------------------------------------------------------
  166.  */
  167. static int
  168. Tcl_TraceConCmd (clientData, interp, argc, argv)
  169.     ClientData    clientData;
  170.     Tcl_Interp   *interp;
  171.     int           argc;
  172.     char        **argv;
  173.     {
  174.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  175.     int          idx;
  176.  
  177.     if (argc < 2)
  178.         goto argumentError;
  179.  
  180.     /*
  181.      * Handle `depth' sub-command.
  182.      */
  183.     if (STREQU (argv[1], "depth")) {
  184.         if (argc == 2) {
  185.             sprintf(interp->result, "%d", infoPtr->depth);
  186.             return TCL_OK;
  187.             }
  188.         if (argc == 3) {
  189.             return (Tcl_GetInt (interp, argv[2], &(infoPtr->depth)));
  190.             }
  191.         goto argumentError;
  192.         }
  193.  
  194.     if (STREQU (argv[1], "depthfloor")) {
  195.         if (argc == 2) {
  196.             sprintf(interp->result, "%d", infoPtr->depthFloor);
  197.             return TCL_OK;
  198.             }
  199.         if (argc == 3) {
  200.             return (Tcl_GetInt (interp, argv[2], &(infoPtr->depthFloor)));
  201.             }
  202.         goto argumentError;
  203.         }
  204.  
  205. argumentError:
  206.     Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  207.                       " depth [level]", (char *) NULL);
  208.     return TCL_ERROR;
  209.  
  210.     }
  211.  
  212. /*
  213.  *----------------------------------------------------------------------
  214.  *
  215.  * Tcl_TraceProcCmd --
  216.  *     Implements the TCL traceproc command:
  217.  *     traceproc procname [arg...]
  218.  *
  219.  * Results:
  220.  *  Standard TCL results.
  221.  *
  222.  *----------------------------------------------------------------------
  223.  */
  224. static int
  225. Tcl_TraceProcCmd (clientData, interp, argc, argv)
  226.     ClientData    clientData;
  227.     Tcl_Interp   *interp;
  228.     int           argc;
  229.     char        **argv;
  230.     {
  231.     register Interp *iPtr = (Interp *) interp;
  232.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  233.     int          idx;
  234.     char        *commandToBeTraced;
  235.     int          result;
  236.  
  237.     if (argc < 2) {
  238.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  239.                           " procname [arg...]", (char *) NULL);
  240.         return TCL_ERROR;
  241.         }
  242.  
  243.     /*
  244.      * If a trace is in progress, delete it now.
  245.      */
  246.     if (infoPtr->traceHolder != NULL) {
  247.         Tcl_DeleteTrace(interp, infoPtr->traceHolder);
  248.         infoPtr->traceHolder = NULL;
  249.         }
  250.  
  251.     infoPtr->depth = MAXINT;
  252.     infoPtr->depthFloor = -1;
  253.       
  254.     infoPtr->traceHolder = 
  255.         Tcl_CreateTrace (interp, MAXINT, TraceRoutine, 
  256.                          (ClientData)infoPtr);
  257.  
  258.     commandToBeTraced = Tcl_Merge (argc - 1, &argv[1]);
  259.     result = Tcl_Eval (interp, commandToBeTraced, 0, NULL);
  260.     ckfree (commandToBeTraced);
  261.  
  262.     Tcl_DeleteTrace (infoPtr->interp, infoPtr->traceHolder);
  263.  
  264.     return TCL_OK;
  265.     }
  266.  
  267.  
  268. /*
  269.  *----------------------------------------------------------------------
  270.  *
  271.  *  CleanUpDebug --
  272.  *
  273.  *  Release the client data area when the trace command is deleted.
  274.  *
  275.  *----------------------------------------------------------------------
  276.  */
  277. static void
  278. CleanUpDebug (clientData)
  279.     ClientData clientData;
  280.     {
  281.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  282.  
  283.     if (infoPtr->traceHolder != NULL)
  284.         Tcl_DeleteTrace (infoPtr->interp, infoPtr->traceHolder);
  285.     ckfree ((char *) infoPtr);
  286.     }
  287.  
  288. /*
  289.  *----------------------------------------------------------------------
  290.  *
  291.  *  Tcl_InitDebug --
  292.  *
  293.  *  Initialize the TCL debugging commands.
  294.  *
  295.  *----------------------------------------------------------------------
  296.  */
  297. void
  298. Tcl_InitnDebug (interp)
  299.     Tcl_Interp *interp;
  300.     {
  301.     traceInfo_pt infoPtr;
  302.  
  303.     infoPtr = (traceInfo_pt)ckalloc (sizeof (struct traceInfo_t));
  304.  
  305.     infoPtr->interp=interp;  /* Save just so we can delete traces at the end */
  306.     infoPtr->traceHolder = NULL;
  307.     infoPtr->depth = 0;
  308.  
  309.     Tcl_CreateCommand (interp, "tracecon", Tcl_TraceConCmd, 
  310.                        (ClientData)infoPtr, CleanUpDebug);
  311.  
  312.     Tcl_CreateCommand (interp, "traceproc", Tcl_TraceProcCmd, 
  313.                        (ClientData)infoPtr, (void (*)())NULL);
  314.     }
  315.